The PC-SIG Library 10/The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso/PC_SIGCD/20/5/DISK2058.ZIP/UNFAST.EXE/WT.F

Text File | 1980-01-01 | 41KB | 2,005 lines

;
;The word processor written entirely in FAST.
;Developed by Peter Campbell, from 24/9/1987 to ...
;

#protect
#errors off
#window memory 4000
#include extinput.fi
#include fsort.fi
#inpend=0
ext_inpend=0

;Screen size !! Change this if setting say EGA 43 lines, probably still bugged.
;** This will not work yet! FAST must be modified to handle variable width.
const width=80,depth=25,lineb=160,width1=width-1   ;lineb=bytes per line.

const xcompilers=4,dl=68,name_len=40
const cfglen=10+51*xcompilers
unsigned md,end_address,current_address,line_address,addl
unsigned block_start,block_end,editm,chkb
var current_column,xpos,ypos,insert,edit_line
var fseg,buffers,current_buffer,backups,last_ypos
var line_print,form_feed,edit_file,line_block,origin_blocka,origin_blockx
var column_block,stab

compile_line ? 128
info         ? 16*dl
name_bak     ? name_len+6
buffer         ? 260
sbuffer      ? 260
ebuffer      ? 260
block_type   ? 2
config         ? cfglen
work         ? 100

goto skip_undef

seperators:
datab ' !^*()-=+\|.,<>/?''":;[]'
sept_end:
const septs=sept_end-seperators

skip_undef:

proc print_to(ptm,ptn)
    {
    pokeb ptm,(ptn/10)+'0'
    pokeb ptm+1,(ptn mod 10)+'0'
    }

proc write_log(wlf)
    {
    open #10,logfile
    if error then
    {
    if error<>2 then return
    create #10,logfile
    write #10,185 from logtop
    }
    else
    {
    var32 wls
    reg bx=handle #10,cx=-1,dx=-1:dos 42(2)
    n=read #10,1 to work:if peekb work=26
        then reg bx=handle #10,cx=-1,dx=-1:dos 42(2)
    }

    fill 16 from logline with 2020h
    m=wlf:n=logline
    while peekb m pokeb n,ucase peekb m:m++:n++
    dos 2a
    rday=low reg dx
    rmonth=high reg dx
    ryear=reg cx-1900
    print_to(logline+34,rday)
    print_to(logline+37,rmonth)
    print_to(logline+40,ryear)
    dos 2c
    rhour=high reg cx
    rminute=low reg cx
    print_to(logline+44,rhour)
    print_to(logline+47,rminute)

    write #10,51 from logline
    close #10
    }

proc bottoms
    {
    colour 7:locate depth-1,0:print
    repeat width print chr 196;
    print:colour 15:cursor depth-1,33
    }

procedure abort
    {
    bottoms
    print bios "<WT finished>"
    terminate
    }

proc input_message
    {
    open window input_window
    colour 120:locate 20,10
    }

on error
    {
    en=error
    if error<1000 then
    {
    bottoms
    error msg "\dos.err"
    print bios "!"
    stop
    }
    open window severe    ;*windows sets error#
    cursor 13,12
    error msg "\wt.err",en
    print bios "!";
    beep
    wait for key=27
    close window
    return
    }

proc must_show
    {
    last_address=-1    ;Force new page display.
    last_ypos=-1
    }

proc inx  xpos+=current_column:current_column=0

function yesno(default)
    {
    forever
    {
    c=ucase key
    if c='Y' then print bios "Y";:return 1
    if c='N' then print bios "N";:return 0
    if c=27  then return 2
    if c=13  then print bios chr 'N'+default*11;:return default
    }
    }

proc get_config
    {
    load config_name,config,cfglen
    if error then
    {
    moveb 10 from config_defaults to config
    fillb 51*xcompilers from config+10 with 0
    }
    backups=peekb config
    stab=peekb (config+1)
    split_enter=peekb (config+2)
    comments=peekb (config+6)
    keep_tab=peekb (config+7)
    moveb 3 from config+3 to default_ext+2
    }

procedure print_name
    {
    colour 70h
    locate 1,2
    repeat 40 print " ";
    locate 1,2
    nm=name+2     ;Print name of file in ucase case with extension.
    while peekb nm
    {
    pokeb nm,ucase peekb nm
    print chr peekb nm;:nm++
    }
    }

function back_line(addl,nlines)
    {
    if nlines then
    {
    repeat nlines
        {
        #short
        if addl=0 then return 0
        addl-=2
        if fseg[addl]b=13 then addl--
        if addl>65520 then return 0

        back_loop:
        if addl=0 then return 0
        b=fseg[addl]b

        if b<>13 then addl--:goto back_loop

        addl+=1+(fseg[addl+1]b=10)
        #long
        }
    }
    return addl
    }

function forward_line(addl,nlines)
    {
    if nlines then
    {
    repeat nlines
        {
        na=addl
        addl=searchb 256 from fseg|addl for 13
        if not addl then
        {
        addl=na
        forward_loop:
        #short
        if addl>=end_address then return end_address
        if fseg[addl]b<>13 then addl++:goto forward_loop
        #long
        }
        addl+=1+(fseg[addl+1]b=10)
        if addl>end_address then return end_address
        }
    }
    return addl
    }

function end_of_line
    {
    start=buffer+254
    while start>=buffer
    {
    #short
    if peekb start<>' ' then goto end_found
    #long
    start--
    }
    end_found:
    return 1+start-buffer
    }

function compress_buffer
    {
    cb_kt=keep_tab
    est=end_of_line+buffer
    st=buffer
    f=sbuffer
    x=0
    while st<est
    {
    b=peekb st
    if cb_kt and (b=' ') then
        {
        bl=(x and 248)+8
        if (bl-x)=1 then goto spput
        flag=1
        for a=1 to bl-x
          if peekb (st+a-1)<>' ' then goto spput
        next a
        b=9:st+=a-2:x=bl-1
        }
    if (b=''') or (b='"') then cb_kt=0
    spput:
    pokeb f,b:f++
    x++:st++
    }
    poke f,0a0dh
    pokeb f+2,1ah
    return f+2-(sbuffer)
    }

proc put_line
    {
    line_dif=0:old_address=editm-300
    if (line_address<>-1) and edit_line then
    {
    line_len=compress_buffer
    next_address=forward_line(line_address,1)
    oldlen=next_address-line_address

    if (end_address-oldlen+line_len) above editm then
        {
        error 1002
        return
        }

    move (end_address-next_address)/2+1 from fseg|next_address
        to fseg|line_address+line_len
    moveb line_len from sbuffer to fseg|line_address

    line_dif=line_len-oldlen
    old_address=line_address
    if line_address<block_end then block_end+=line_dif
    if line_address<origin_blocka then origin_blocka+=line_dif
    if line_address<current_address then current_address+=line_dif
    end_address+=line_dif
    edit_file=1
    edit_line=0
    }
    }

procedure put_details
    {
    put_line
    pos=current_buffer*dl+info

    pokeb pos,xpos:pokeb pos+1,ypos
    poke pos+2,current_address
    poke pos+4,current_column
    poke pos+6,end_address
    poke pos+8,fseg
    poke pos+10,editm
    pokeb pos+12,edit_file
    moveb 55 from name+2 to pos+13
    }

procedure get_details
    {
    pos=current_buffer*dl+info

    xpos=peekb pos
    ypos=peekb (pos+1)
    current_address=peek (pos+2)
    current_column=peek (pos+4)
    end_address=peek (pos+6)
    fseg=peek (pos+8)
    editm=peek (pos+10)
    edit_file=peekb (pos+12)
    moveb 55 from pos+13 to name+2

    must_show
    line_address=-1
    print_name
    }

proc word_default
    {
    pokeb default_menu+1,0
    opt=1
    open window default_menu
    wd_back:
    colour 10110b
    locate 4,58:m=default_ext+2:while peekb m print chr ucase peek m;:m++
    locate 5,55:if backups then print "ON "; else print "OFF";
    locate 6,58:if split_enter then print "ON "; else print "OFF";
    locate 7,58:printb stab;
    locate 8,56:if comments then print "C  "; else print "ASM";
    locate 9,58:if keep_tab then print "YES"; else print "NO ";
    pokeb default_menu+1,7

    opt=select default_menu,opt
    if not opt then close window:return
    if opt=1 then
    {
    open window def_input
    locate 10,69:colour 60h
    l=ext_input(default_ext)
    close window
    }
    if opt=2 then backups=not backups
    if opt=3 then split_enter=not split_enter
    if opt=4 then
    {
    open window tab_input
    push stab
    cursor 7,67
    stab=inputb
    if not stab then pop stab else pop x
    if stab>20 then stab=20
    if stab<1 then stab=1
    close window
    }
    if opt=5 then comments=not comments
    if opt=6 then keep_tab=not keep_tab
    if opt=7 then
    {
    pokeb config,backups
    pokeb config+1,stab
    pokeb config+2,split_enter
    pokeb config+6,comments
    pokeb config+7,keep_tab
    moveb 3 from default_ext+2 to config+3
    save config_name,config,cfglen
    if error then error 1001
    }
    goto wd_back
    }

proc start_buffer
    {
    xpos=0:ypos=0
    current_address=0:current_column=0
    end_address=searchb 65535 from fseg|0 for 26

    editm=65520
    if end_address<40000 then editm=end_address+8000
    modify fseg to (editm/16)+1

    edit_file=0:edit_line=0
    must_show:line_address=-1
    put_details:print_name
    line_block=0:column_block=0
    }

function first_nonblank
    {
    fbx=0
    while (fbx<255) and (peekb (buffer+fbx)=' ') fbx++
    if fbx=255 then fbx=0
    return fbx
    }

procedure set_old
    {
    last_address=current_address
    last_column=current_column
    }

proc cline(cy)
    {
    m=cy*lineb+1
    repeat width video[m]b=7:m+=2
    }

proc fill_block(x1,y1,x2,y2,fc)
    {
    y1+=2:y2+=2
    if x1<0 then x1=0
    if x2<0 then x2=0
    if x1>width1 then x1=width1
    if x2>width1 then x2=width1

    y=2
    while y<y1 cline(y):y++

    while y<=y2
    {
    m=y*lineb+1
    x=0
    while x<x1 video[m]b=7:m+=2:x++
    while x<=x2 video[m]b=fc:m+=2:x++
    while x<width video[m]b=7:m+=2:x++
    y++
    }

    while y<depth cline(y):y++
    }

proc reset_block
    {
    column_block=0
    line_block=0
    fill_block(0,0,width1,depth-3,7)
    }

proc mark_columns(mcx)
    {
    put_line
    reset_block
    column_block=1
    origin_blocka=line_address
    origin_blockx=mcx
    }

proc draw_block
    {
    newx1=xpos:newy1=ypos
    if line_block then newx1=255

    newx2=origin_blockx-current_column
    newy2=0
    sa=current_address
    while (newy2<(depth-2)) and (sa below origin_blocka)
    {
    newy2++
    sa=forward_line(sa,1)
    }

    if newx1>newx2 then swap newx1,newx2
    if newy1>newy2 then swap newy1,newy2

    fill_block(newx1,newy1,newx2,newy2,120)
    }

proc home  current_column=0:xpos=0

proc top_of_file  current_address=0:ypos=0:home

proc put_char(pchr)
    {
    pcx=current_column+xpos
    if pcx<255 then
    {
    if insert then moveb 255-pcx from pcx+buffer to pcx+1+buffer
    pokeb buffer+pcx,pchr
    xpos++
    edit_line=1
    }
    }

function sept(sx)
    {
    sbyte=peekb (buffer+sx)
    return searchb septs from seperators for sbyte
    }

function word_left(wx)
    {
    x=wx
    if x then x--
    if sept(x) then
    {
    while x>=0
        {
        if not sept(x) then goto wl2
        x--
        }
    return 0
    }

    wl2:
    while x>=0
    {
    if sept(x) then return x+1
    x--
    }
    return 0
    }

function word_right(wx)
    {
    x=wx
    while x<256
    {
    if sept(x) then goto wr2
    x++
    }
    goto wr_end

    wr2:
    while x<256
    {
    if not sept(x) then return x
    x++
    }

    wr_end:
    if x>=end_of_line then return end_of_line
    return wx
    }


proc del(xd) moveb 255-xd from buffer+xd+1 to buffer+xd:edit_line=1

proc back(xd)
    {
    if xd then
    {
    moveb 256-xd from buffer+xd to buffer-1+xd
    xpos--
    }
    edit_line=1
    }

proc clear_line fill 130 from buffer with 2020h:home:edit_line=1

proc clear_eol
    {
    pcx=current_column+xpos
    fillb 256-pcx from buffer+pcx with 20h
    edit_line=1
    }

function make_memory
    {
    fseg=allocate 4096 ;64k
    if error then error 1002:return 0
    else fill 32768 from fseg|0 with 1a1ah  ;All end characters.
    return fseg
    }

procedure screen_display
    {
    colour 7:cls:locate 0,0
    fill width from video|0 with 5020h
    colour 50h
    print " WT v2.07 By Peter Campbell.      F1-Help   Files   Compile     Defaults"
    fill width from video|lineb with 7020h
    colour 70h
    locate 1,44:repeat 36 print " ";
    }

proc parameters
    {
    colour 70h
    locate 1,54:print "Col=";current_column+xpos+1;"  ";
    locate 1,63:print "Size=";end_address;"    ";
    }

function insert_block(s,bseg,e,l)
    {
    put_line
    if (end_address+l) > (editm-300) then error 1003:return 0

    move (end_address-s)/2+1 from fseg|s to fseg|s+l
    moveb l from bseg|e to fseg|s

    if (s below origin_blocka) or (s=origin_blocka) then origin_blocka+=l
    end_address+=l
    edit_file=1:edit_line=0
    must_show:line_address=-1
    return 1
    }

proc split_line(sx,ss)
    {
    fill 128 from ebuffer with 2020h
    moveb 256-sx from buffer+sx to ebuffer+ss
    clear_eol:current_column=0:xpos=end_of_line

    push insert
    insert=1
    put_char(13):put_char(10)
    pop insert

    put_line
    line_address=forward_line(line_address,1)
    edit_line=1
    move 128 from ebuffer to buffer

    must_show
    }

proc centre_line
    {
    if ypos>11
    then current_address=forward_line(current_address,ypos-11):ypos=11
    else
    {
    md=back_line(current_address,11-ypos)
    nd=forward_line(md,11-ypos)
    if nd=current_address then current_address=md:ypos=11
    }
    }

proc delete_block(ds,de)
    {
    put_line
    if ds above de then swap ds,de
    move (end_address-de)/2+1 from fseg|de to fseg|ds
    if ds below origin_blocka then
    origin_blocka-=de-ds:if carry then reset_block
    if current_address>ds then
    current_address-=de-ds:if carry then current_address=0
    end_address-=de-ds
    fseg[end_address]b=26
    must_show
    line_address=-1:edit_file=1
    }

proc delete_line
    {
    put_line
    ea=forward_line(line_address,1)
    delete_block(line_address,ea)
    }

function get_column(ea)
    {
    col=0:ga=current_address
    while col<255
    {
    if ga=ea then return col
    byte=fseg[ga]b:ga++
    if (byte=13) or (byte=26) then return col
    if byte=9 then col=(col and 248)+8
    else col++
    }
    wait for key=27
    return 0
    }

proc get_line(ga)
    {
    if line_address=ga then return
    put_line
    if ga above old_address then ga+=line_dif
    line_address=ga

    fill 130 from buffer with 2020h
    col=0
    edit_line=0

    while col<255
    {
    byte=fseg[ga]b:ga++
    if (byte=13) or (byte=26) then return
    if byte=9 then col=(col and 248)+8
    else
        {
        pokeb buffer+col,byte
        col++
        }
    }
    error 1004
    }

function scrap(do)
    {
    put_line
    line_address=forward_line(current_address,ypos)
    input_message:print "Saving block...";

    if line_block or column_block then
    {
    block_start=origin_blocka
    block_end=line_address
    if block_start>block_end then swap block_start,block_end
    }
    else
    {
    block_start=line_address
    block_end=line_address
    }
    block_end=forward_line(block_end,1)

;#if 1
;   print " as: ";
;   ni=ext_input(block_name_i)
;   create #1,block_name_i+2
;#endif
    create #1,block_name:if error then error 1005:return

    if not column_block then
    {
    write #1,block_end-block_start from fseg|block_start
    if error then close #1:error 1005:return
    if do then
        {
        delete_block(block_start,block_end)
        if block_start<current_address then current_address=block_start
        }
    }

    if column_block then
    {
    x1=origin_blockx
    xc=xpos+current_column
    if xc<x1 then swap x1,xc
    scrap_len=1+xc-x1
    pokeb block_type,0:pokeb block_type+1,scrap_len
    write #1,2 from block_type
    if error then close #1:error 1005:return

    while block_start<block_end
        {
        get_line(block_start)
        write #1,scrap_len from buffer+x1
        if error then close #1:error 1005:return
        if do then moveb 256-x1-scrap_len
        from buffer+x1+scrap_len to buffer+x1:edit_line=1
        block_start=forward_line(line_address,1)
        }
    put_line
    }

    close #1
    if do then must_show:line_address=-1
    close window
    reset_block
    return 1
    }

proc read_columns
    {
    inx
    scrap_len=peekb (block_type+1)
    scrap_ca=line_address
    if (scrap_len+xpos)>255 then error 1006:return

    forever
    {
    get_line(scrap_ca)
    moveb 256-xpos-scrap_len from xpos+buffer to xpos+scrap_len+buffer
    rlen=read #1,scrap_len to buffer+xpos:if error then return
    if rlen<>scrap_len then return
    edit_line=1
    put_line
    scrap_ca=forward_line(scrap_ca,1)
    }
    }

proc join_line(xj)
    {
    x=end_of_line
    if xj<x then xj=x
    ml=forward_line(line_address,1)
    move 128 from buffer to ebuffer
    push line_address
    get_line(ml)
    moveb 256-xj from buffer to ebuffer+xj
    delete_line
    pop line_address
    move 128 from ebuffer to buffer
    edit_line=1

    must_show
    }

proc shift_left
    {
    current_column=0
    xpos=first_nonblank
    xn=(xpos/stab)*stab-stab
    if xn<0 then xn=0
    if xpos then
    {
    moveb 256-xpos from buffer+xpos to buffer+xn
    edit_line=1
    }
    }

proc shift_right
    {
    current_column=0
    xpos=first_nonblank
    xn=((xpos+stab)/stab)*stab
    moveb 256-xn from buffer+xpos to buffer+xn
    fillb xn-xpos from buffer+xpos with ' '
    edit_line=1
    }

procedure page_display
    {
    set_old
    colour 7
    md=current_address

    for yp=2 to depth-1
    locate yp,0
    col=0
    while col<current_column
    {
    #short
    b=fseg[md]b
    if b=13 then
        {
        fill width from video|locpos with 0720h
        md++:goto page_nl
        }
    if b<>9 then col++ else col=(col and 248)+8
    if md=end_address then goto page_end
    md++
    #long
    }

    line_loop:
    md=printm fseg|md,width
    if md=end_address then goto page_end
    ffc=fseg[md-1]b
    if (ffc<>13) and (ffc<>10) then
    {
    md=searchb 256 from fseg|md for 13
    if md=0 then goto page_end
    md++
    if fseg[md]b=10 then md++
    if md>=end_address then goto page_end
    }

    page_nl:
    next yp
    return

    page_end:
    m=yp*lineb+lineb
    m2=lineb*depth
    if m<m2 then repeat (m2-m)/2 video[m]b=' ':m+=2
    }

proc print_buffer  ml=printm buffer+current_column,width,0

procedure print_line(py)
    {
    locate 2+py,0
    ma=forward_line(current_address,py)
    get_line(ma)
    last_ypos=py
    print_buffer
    }

function get_directory
    {
    dir_seg=allocate 1024:if error then error 1007:return 0
    dir name+2,dir_seg|0:files=dir_seg[0]
    if not files then
    {
    none_dir:
    error 1008

    exit_dir:
    deallocate dir_seg
    return 0
    }

    if not sort(dir_seg,2,13,files) then goto none_dir
    x=0:lx=-1
    open window direct_window
    colour 10110b
    locate 23,3:print " ";files;" file(s) ";

    forever
    {
    if (x/60)<>lx then
        {
        start=(x/60)*60
        lx=x/60
        px=2:py=11

        while py<23
        {
        locate py,px:print "        ";:locate py,px
        if start<files then
            {
            st=(start*13)+2
            while dir_seg[st]b print chr dir_seg[st]b;:st++
            start++
            }
        px+=16:if px>75 then px=2:py++
        }
        }

    py=(x mod 60)/5:px=x mod 5
    locate py+11,px*16+2:st=locpos+1:old=st
    repeat 12 video[st]b=112:st+=2

    wait for keypressed:s=scan
    if s=1 then close window:goto exit_dir
    if s=72 then x-=5
    if s=80 then x+=5
    if s=75 then x--
    if (s=77) or (s=15) then x++
    if s=73 then x-=60
    if s=81 then x+=60
    if (s=71) or (x<0) then x=0
    if (s=79) or (x>=files) then x=files-1

    st=old:repeat 12 video[st]b=10110b:st+=2

    if s=28 then
        {
        move 7 from dir_seg|x*13+2 to name+2
        close window
        deallocate dir_seg
        return 1
        }
    }
    }

function load_buffer(use_command)
    {
    retry_load:
    if buffers=16 then error 1010:return 0
    open window input_load_name

    colour 10111b
    locate 13,62:print "[.";
    st=default_ext+2
    while peekb st print chr(ucase peek st);:st++
    print "]";

    locate 13,13
    l=1:if not use_command then l=ext_clean_input(name)
    if (peekb (name+2)=0) or (l=0) then close window:return 0

    nm=name+2
    while peekb nm<=' ' nm++
    moveb name_len from nm to name+2

    nm=name+2:cd=0
    while peekb nm cd+=peekb nm='.':nm++
    if not cd then
    {
    pokeb nm,'.'
    move 2 from default_ext+2 to nm+1
    }

    wild=0
    nm=name+2
    while peekb nm
    {
    b=peekb nm
    if (b='*') or (b='?') then wild=1
    nm++
    }
    if wild then if not get_directory then
    {
    close window:use_command=0
    goto retry_load
    }

    locate 13,13:nm=name+2
    while peekb nm print chr(ucase peek nm);:nm++

    fseg=make_memory
    if not fseg then close window:return 0
    fseg[65500]b=1ah
    load name+2,fseg|0,65501
    if error then
    {
    if error<>2 then error 1009:close window:return 0
    print "  (new file)"
    repeat 3 repeat 50000 {}
    }
    if fseg[65500]b<>1ah then error 1020

    close window
    current_buffer=buffers
    buffers++
    start_buffer
    return 1
    }

proc display_buffers
    {
    pokeb sel_buf+5,buffers+6 ;Only size for the number of buffers.
    poke sel_buf,1
    open window sel_buf
    start=info+13
    y=6
    colour 1fh
    repeat buffers
    {
    pos=start
    locate y,8
    while peekb pos print chr ucase peek pos;:pos++
    if peekb (start-1) then print " (save)";
    y++
    start+=dl
    }
    pokeb sel_buf,1:pokeb sel_buf+1,buffers
    }

function select_buffer
    {
    display_buffers
    y=select sel_buf,current_buffer+1
    close window
    if not y then get_details:return 0
    current_buffer=y-1
    get_details
    return 1
    }

proc set_positions
    {
    while xpos<0
    {
    xpos+=8
    current_column-=8
    if current_column<0 then current_column=0:xpos=0
    }
    while xpos>width1
    {
    xpos-=8
    current_column+=8
    if current_column>176 then current_column=176:xpos=width1
    }
    if ypos<0 then ypos=0:current_address=back_line(current_address,1)
    if ypos>(depth-3) then ypos=depth-3:current_address=forward_line(current_address,1)
    if current_column<0 then current_column=0
    if current_column>176 then current_column=176
    if current_address above end_address then current_address=end_address

    if (current_address<>last_address) or (ypos<>last_ypos) then
    {
    ma=current_address
    yo=0
    if ypos then
        {
        repeat ypos
        {
        oldma=ma
        ma=forward_line(ma,1)
        if ma=oldma then ypos=yo:goto get_yo
        yo++
        }
        }
    get_yo:
    get_line(ma)
    last_ypos=ypos
    }

    if (current_address<>last_address) or (current_column<>last_column) then
    {
    if keypressed then
        {
        last_address=-1
        goto exe_key
        }
    colour 7
    if current_address=last_address then goto page_all
    md=forward_line(current_address,1)
    if md=last_address then
        {
        scroll down 0,2,width1,depth-1,1
        print_line(0)
        goto edit_page
        }
    md=back_line(current_address,1)
    if md=last_address then
        {
        scroll 0,2,width1,depth-1,1
        print_line(depth-3)
        goto edit_page
        }

    page_all:
    page_display

    edit_page:
    set_old
    }

    exe_key:

    if (current_address<>last_address) or (ypos<>last_ypos) then
    {
    ma=forward_line(current_address,ypos)
    get_line(ma)
    last_ypos=ypos
    }

    if column_block or line_block then draw_block

    locate ypos+2,0
    print_buffer
    parameters
    if mono
    then cursor size 12-(insert*4),13
    else cursor size 6-(insert*2),7
    cursor ypos+2,xpos
    }

function finds(fs,fe,findseg)
    {
    flen=fe-fs
    while flen
    {
    f=searchb flen from findseg|fs for peekb (findstr+2)
    if f then
        {
        m=findstr+3
        f2=f:fxadd=f
        while peekb m
        {
        #short
        c=peekb m:m++:f2++
        if c='?' then goto fnchar
        if c<>findseg[f2]b then goto fnext
        fnchar:
        #long
        }
        if findseg<>reg cs then
        {
        if (findseg[f2-1]b<>10) and (findseg[f2-1]b<>13)
        then current_address=back_line(f2,1)
        else current_address=f2
        }
        return 1

        fnext:
        f++
        flen=fe-f:fs=f
        if f above fe then return 0
        }
    else return 0
    }
    return 0
    }

function find_string
    {
    if finds(buffer+xpos+current_column,buffer+255,reg cs) then
    {
    xpos=f-buffer:current_column=0
    return 1
    }
    nl=forward_line(current_address,ypos+1)
    if finds(nl,end_address,fseg) then
    {
    current_column=0:xpos=get_column(fxadd)
    ypos=0:centre_line
    return 1
    }
    return 0
    }

proc input_find(first)
    {
    if first then
    {
    input_message
    print "Find: ";
    findl=ext_input(findstr)
    c=0:if findl then c=peekb(findstr+2)
    if c=0 then close window:return 0
    findl--
    }
    else xpos++

    if find_string then
    {
    if first then close window
    return 1
    }
    if first then close window

    input_message
    print "Text not found!"
    wait for keyscan
    close window
    if not first then xpos--
    return 0
    }

proc input_replace(first)
    {
    ir=input_find(first)
    if first then
    {
    input_message
    print "Replace: ";
    replacel=ext_input(replacestr)
    c=0:if replacel then c=peekb(replacestr+2)
    close window
    if c=0 then return 0
    replacel--
    }

    replace_again:
    if ir then
    {
    last_address=-1:set_positions
    input_message
    print "Replace Yes/No/All or ESC? ";
    wait for keypressed:rk=lcase key:print chr rk;
    replace=0          ;Default: replace none.
    if rk='y' then replace=1     ;One only.
    if rk='a' then replace=32767    ;Max.
    close window
    if rk=27 then return

    if replace=0 then xpos++:ir=find_string
    while (replace<>0) and (ir<>0)
        {
        moveb 256-xpos-findl from buffer+xpos+findl to buffer+xpos+replacel
        moveb replacel from replacestr+2 to buffer+xpos
        edit_line=1
        replace--
        xpos+=replacel:ir=find_string
        if (replace<>0) and (ir<>0) then set_positions
        }
    if replace then last_address=-1:set_positions
    goto replace_again
    }
    }

proc print_file
    {
    input_message:loctocur
    print bios "Print current Scrap or File? (s/f) ";
    wait for keypressed
    pk=lcase key
    print bios chr pk;" ... ESC aborts.";

    if pk='s' then
    {
    lps=allocate 4096:if error then error 1016:goto end_lprint
    fill 32768 from lps|0 with 1a1ah
    load block_name,lps|0
    if error then error 1005:goto lp_deall
    if lps[0]b then
        {
        m=0
        while lps[m]b<>1ah
        {
        lprint chr lps[m]b;:m++
        if key=27 then goto lp_deall
        }
        }
    else
        {
        scrap_len=lps[1]b
        m=2:c=scrap_len
        while lps[m]b<>1ah
        {
        lprint chr lps[m]b;
        m++
        c--
        if c=0 then lprint:c=scrap_len
        }
        }
    lp_deall:
    deallocate lps
    }
    else if pk='f' then
    {
    m=0
    while fseg[m]b<>1ah
        {
        lprint chr fseg[m];:m++
        if key=27 then goto end_lprint
        }
    }

    end_lprint:
    close window
    }

proc load_file
    {
    x=load_buffer(0)
    if not x then
    {
    if not buffers then abort
    get_details
    }
    }

proc save_file(new_nameq)
    {
    put_line
    if new_nameq then
    {
    input_message
    print "Save file as: ";
    l=ext_input(name)
    close window
    if not l then return
    print_name
    }

    moveb name_len+6 from name+2 to name_bak
    f=searchb name_len+6 from name_bak for '.'
    if not f then f=searchb name_len+6 from name_bak for 0
    if f then moveb 5 from bak_extension to f

    if backups then
    {
    delete name_bak ;If error then assume doesn't exist.
    rename name+2 to name_bak:if error>2 then error 1021:return
    }

    create #1,name+2:if error then error 1021:return
    write #1,end_address+1 from fseg|0:if error then close #1:error 1021:return
    close #1

    write_log(name+2)

    edit_file=0:edit_line=0
    put_details
    }

proc save_alter
    {
    if edit_file then
    {
    open window save_altered_file
    retry_yesno:
    cursor 12,51
    wait_yesno:
    byte=lcase key
    if byte=27 then close window:return
    if (byte<>'y') and (byte<>'n') then goto wait_yesno
    close window
    if byte='y' then save_file(0)
    if byte='n' then edit_file=0
    }
   }

proc exe(ad)
    {
    close windows
    colour 7:cls
    cursor 0,0

    poke exe_com+4,reg cs
    poke exe_com+8,reg cs
    poke exe_com+12,reg cs

    m=ad
    while peekb m print bios chr lcase peek m;:m++
    m=compile_line+1
    while peekb m<>13 print bios chr lcase peek m;:m++
    print bios

    execute ad,exe_com
    if error then error 1011
    }

proc compile
    {
    if edit_file then save_file(0)

    compile1:
    pokeb comp_menu+1,0
    open window comp_menu
    compile2:
    start=config+10:colour 60h
    for y=1 to xcompilers
    m=start
    locate y+7,14
    while peekb m print chr peek m;:m++
    start+=51
    next y

    comp_loop:
    pokeb comp_menu+1,xcompilers+1
    co=select comp_menu,2
    if not co then close window:return
    if co=1 then
    {
    pokeb comp_menu+1,xcompilers
    pokeb comp_menu+3,5
    co=select comp_menu,1
    if co then
        {
        locate co+7,14
        ckm=config+10+(co-1)*51
        moveb 51 from ckm to comp_input+2
        l=ext_input(comp_input)
        if l then moveb 51 from comp_input+2 to ckm
        x=searchb 50 from ckm for 0
        if x then fillb 51-(x-ckm) from x with 0
        }
    pokeb comp_menu+3,4
    close window
    goto compile1
    }

    nameslen=(searchb name_len from name+2 for 0)-(name+2)
    move 25 from config+10+(co-2)*51 to name_bak
    poke compile_line,0d01h
    f=searchb 50 from name_bak for ' '
    if f then
    {
    move 25 from f to compile_line+1
    pokeb f,0
    f=compile_line+1
    while peekb f
        {
        if peekb f='%' then
        {
        moveb compile_line+100-f from f to f+nameslen-1
        moveb nameslen from name+2 to f
        f+=nameslen-1
        }
        f++
        }
    pokeb f,13
    pokeb compile_line,f-compile_line
    }

    exe(name_bak)

    print bios cr lf
    cursor 24,0:print bios "Press any key to return to WT";
    wait for keyscan
    }

proc exit_file(flag)
    {
    if flag then
    {
    if not select_buffer then return
    save_alter
    if edit_file then return
    }

    parameters
    deallocate fseg

    if current_buffer<>(buffers-1) then moveb ((buffers-1)-current_buffer)*dl
       from info+(1+current_buffer)*dl to current_buffer*dl+info

    buffers--
    current_buffer=0
    get_details
    if not buffers then load_file
    }

proc exit_wordq
    {
    eflag=0
    for file=0 to buffers-1
    current_buffer=file
    get_details
    if edit_file then
    {
    if eflag=0 then
        {
        eflag=1
        pokeb wind_files+5,buffers+5
        open window wind_files:y=4
        }
    locate y,2
    nm=name+2
    while peekb nm print chr ucase peek nm;:nm++
    y++
    }
    next file

    while eflag
    {
    eflag=0
    no=0
    locate y,2
    print "Save file(s)? y/n ";
    no_againq:
    loctocur
    wait for keypressed
    r=ucase key
    if r='N' then
        {
        if no then abort
        no=1:beep:goto no_againq
        }
    close window
    if r<>'Y' then return
    for file=0 to buffers-1
    current_buffer=file
    get_details
    if edit_file then save_file(0):if edit_file then eflag=1
    next file
    }

    abort
    }

proc help_me
    {
    must_show
    #errors off
    hs=allocate 2048/16:if error then goto help_err
    load "\wt.hlp",hs|0,2048:if error then goto help_err2
    #errors on

    m=0:colour 7
    for y=2 to depth-1
    locate y,0
    m=printm hs|m,width
    next y

    wait for keyscan
    deallocate hs
    return

    help_err2:
    deallocate hs
    help_err:
    error 1015
    }

proc word_files
    {
    word_start:
    put_details
    sw=menu files_menu:goto word_files2
    forever
    {
    sw=select files_menu,sw
    word_files2:
    if not sw then close window:return
    if sw=1 then exit_file(1):if not buffers then abort
    if sw=2 then
        {
        poke compile_line,0d01h
        exe(dos_shell)
        goto entry
        }
    if sw=3 then exit_wordq
    }
    }

;- main entry ---------------------------------------------------------------

get_config
buffers=0
screen_display
insert=1

nm=81h
while peekb nm<>13
    {
    if peekb nm>' ' then
    {
    pokeb name+1,peekb 80h-nm+81h
    moveb name_len from nm to name+2
    m=searchb name_len from name+2 for 13
    if m then pokeb m,0
    if not load_buffer(1) then abort
    goto entry
    }
    nm++
    }

if not load_buffer(0) then abort

entry:
screen_display
page_display
print_name
must_show
line_address=-1

edit:
set_positions

wait for keypressed
ks=keyscan
k=low ks:s=high ks

;Handle keypad cursor movement.
if ks=18688 then current_address=back_line(current_address,23):goto edit
if ks=20736 then current_address=forward_line(current_address,23):goto edit
if peekb 0|417h and 16 then
    {
    if ks=18432 then current_address=back_line(current_address,1):goto edit
    if ks=20480 then current_address=forward_line(current_address,1):goto edit
    if ks=19200 then current_column-=stab:goto edit
    if ks=19712 then current_column+=stab:goto edit
    }
else
    {
    if ks=18432 then ypos--
    if ks=20480 then ypos++
    if ks=19200 then xpos--
    if ks=19712 then xpos++
    }
if ks=18176 then home
if ks=20224 then current_column=0:xpos=end_of_line
if ks=30464 then ypos=0
if ks=29952 then ypos=depth-3
if ks=33792 then top_of_file
if ks=30208 then
    {
    current_address=back_line(end_address,depth-3)
    ypos=depth-3:home
    }
if ks=18231 then xpos=first_nonblank:goto edit
if ks=29440 then inx:xpos=word_left(xpos)
if ks=29696 then inx:xpos=word_right(xpos)

;Special character movement functions.
if ks=3840 then xpos=(xpos/stab)*stab-stab
if ks=3849 then
    {
    newx=((xpos+stab)/stab)*stab
    if insert then
    {
    if (newx+current_column)>255 then newx=0
    while newx>xpos
        {
        put_char(' ')
        }
    }
    else xpos=newx
    goto edit
    }
if ks=20992 then insert=not insert
if ks=21248 then del(current_column+xpos)
if ks=3592 then back(current_column+xpos):goto edit
if ks=4608 then clear_line
if ks=9472 then clear_eol

;Line functions.
if k=13 then
    {
    enter_line:
    enx=first_nonblank
    if not split_enter then current_column=0:xpos=end_of_line
    split_line(xpos+current_column,enx)
    ypos++:xpos=enx:current_column=0
    goto edit
    }
if ks=17408 then
    {
    push insert
    insert=1
    put_char(' '):xpos--
    pop insert
    }
if ks=5632 then
    {
    line_address=-1
    ma=forward_line(current_address,ypos)
    get_line(ma)
    last_ypos=ypos
    home
    }
if (ks=5401) or (ks=3711) then
    {
    delete_line
    goto edit
    }
if ks=7936 then
    {
    split_line(xpos+current_column,0)
    ypos++:home
    }
if ks=9216 then join_line(xpos+current_column)
if ks=5120 then
    {
    atx=end_of_line+1
    join_line(atx)
    repeat 254
    {
    if peekb(buffer+atx)<>' ' then goto exit_at
    del(atx)
    }
    exit_at:
    }
if ks=16640 then shift_left
if ks=16896 then shift_right
if ks=23040 then shift_left:ypos++:must_show
if ks=23296 then shift_right:ypos++:must_show
if ks=27648 then
    {
    home
    push insert
    insert=1
    if comments
    then put_char('/'):put_char('*')
    else put_char(';')
    repeat 75 put_char('=')
    if comments then put_char('*'):put_char('/')
    pop insert
    split_line(xpos+current_column,0)
    ypos++:home
    }

;Pop-up menu keys.
if ks=8448 then word_files
if ks=8192 then word_default
if ks=11776 then put_details:compile:goto entry

;Special ALT/CTRL-key functions.
if (ks=12544) and (buffers>1) then
    {
    put_details
    current_buffer++
    if current_buffer=buffers then current_buffer=0
    get_details
    }
if ks=8704 then
    {
    input_message:loctocur
    print bios "Goto line: ";
    curtoloc
    gline=input
    n=video[locpos]b
    close window
    if n>='0' then
    {
    top_of_file
    if gline then gline--
    current_address=forward_line(current_address,gline)
    }
    }
if ks=5140 then
    {
    current_address=forward_line(current_address,ypos)
    ypos=0:goto edit
    }
if ks=12290 then
    {
    current_address=back_line(current_address,depth-3-ypos)
    ypos=depth-3:goto edit
    }
if ks=11779 then centre_line:goto edit
if ks=4613 then
    {
    if editm<>65520 then
    {
    fseg2=allocate 4096:if error then error 1002:goto edit
    moveb end_address+1 from fseg|0 to fseg2|0
    deallocate fseg
    fseg=fseg2:editm=65520
    }
    goto edit
    }

;File option keys.
if ks=15104 then help_me
if ks=15360 then put_details:b=select_buffer
if ks=15616 then save_file(1)
if ks=15872 then put_details:load_file
if ks=11520 then put_details:exit_wordq
if ks=17152 then put_details:print_file:must_show:line_address=-1
if ks=27136 then
    {
    put_details
    if edit_file then save_file(0)
    exit_file(0)
    goto edit
    }

;Find/replace options.
if ks=16128 then input_find(1)
if ks=16384 then input_replace(1)
if ks=22528 then input_find(0)
if ks=22784 then input_replace(0)

;Blocks
if ks=9728 then
    {
    if line_block then reset_block
    else
    {
    put_line
    reset_block
    line_block=1
    origin_blockx=0
    origin_blocka=line_address
    }
    }
if ks=12288 then
    {
    if column_block then reset_block
    else mark_columns(xpos+current_column)
    }
if ks=20011 then
    {
    if peekb 0|417h and 3 then n=scrap(0):goto edit
    }
if ks=18989 then
    {
    if peekb 0|417h and 3 then n=scrap(1):goto edit
    }
if ks=4864 then
    {
    put_line
    id=forward_line(line_address,1)
    if insert_block(line_address,fseg,id,id-line_address) then ypos++
    }
if ks=21040 then
    {
    put_line
    input_message:print "Inputting block..."
    open #1,block_name:if error then goto cs_error
    seek #1,eof:block_len=reg ax
    if carry then close #1:goto cs_error
    c=end_address+block_len:if carry then
    {
    error 1013:close #1:close window:goto edit
    }
    seek #1,0
    two=read #1,2 to block_type
    if (two<>2) or (error<>0) then goto cs_error
    if not peekb block_type then read_columns:goto readi2
    ;Read lines.
    ola=line_address
    if insert_block(line_address,fseg,0,block_len) then
    {
    seek #1,0
    read_len=read #1,block_len to fseg|ola
    if read_len<>block_len then goto cs_error
    }
    readi2:
    close #1:close window
    reset_block:must_show:line_address=-1
    goto edit

    cs_error:
    error 1005
    close window
    goto edit
    }
if ks=7680 then mark_columns(0)
if ks=11264 then mark_columns(end_of_line)
if ks=4352 then
    {
    inx:x=word_right(xpos):x=word_left(x):xpos=x:mark_columns(x)
    while xpos<256
    {
    if sept(xpos) then xpos--:goto edit
    xpos++
    }
    }

if k then if k<>26 then put_char(k)
goto edit

;== WT data ================================================================

dos_shell:    fname '\command.com'
block_name:    fname '\wt.ins'
logfile:    fname 'wt.log'
config_name:    fname 'wt.cfg'
bak_extension:    fname '.BAK'

comp_input:    string 50
itext:        string 30
block_name_i:    string 20

eol_code:    datab 13
default_ext:    datab 4,0,'F',0,0,0

exe_com:
data 0
data compile_line,0
data 5ch,0
data 6ch,0

comp_menu:
datab 1,12,13,4,64,8+xcompilers,60h
datab 22,19,1,'Select compiler.'
datab 22,1,3,'Modify selected compiler.'
datab 26

direct_window:
datab 0,0,0,10,79,23,10111b,26

severe:
datab 0,0,10,11,70,16,4fh
datab 22,16,4,'Press ESC'
datab 26

name:
data name_len
space name_len+8

input_load_name:
datab 0,0,11,9,69,16,10111b
datab 22,2,2,'Enter exact file name or use wild cards for directory.'
datab 26

save_altered_file:
datab 0,0,24,10,55,14,1001111b
datab 22,2,2,'Save changed file? (Y/N)'
datab 26

save_errorw:
datab 0,0,16,7,65,12,1001110b
datab 22,16,2,'Error saving file!'
datab 22,2,3,'Press escape to abort, any other key to retry'
datab 26

files_menu:
datab 1,3,30,2,51,8,10111b
datab 22,6,1,      'Files Menu'
datab 22,2,3,'Remove file'
datab 22,2,4,'DOS shell'
datab 22,2,5,'Exit editor  ALT-X'
datab 26

sel_buf:
datab 1,0,6,3,73,16,1fh
datab 22,28,1,'Select a File'
datab 26

def_input:
datab 0,0,52,8,75,12,60h
datab 22,3,2,'New default : '
datab 26

tab_input:
datab 0,0,55,5,74,9,15
datab 22,2,2,'New tab = '
datab 26

default_menu:
datab 1,0,45,1,70,11,10110b
datab 22,2,1,'WT Defaults'
datab 22,2,3,'Extension:'
datab 22,2,4,'Backups'
datab 22,2,5,'Line split'
datab 22,2,6,'Tab step = '
datab 22,2,7,'Comments'
datab 22,2,8,'Keeps tabs'
datab 22,2,9,'Save configuration'
datab 26

input_window:
datab 0,0,8,18,79,22,120
datab 26

config_defaults:
datab 1,4,0,'F',0,0
datab 0,1,0,0

findstr: string 30
replacestr: string 30
space 1

wind_files:
datab 0,0,0,3,40,1,120,26

logtop:
datab 'WT text editor log file: By Peter Campbell',13,10,13,10
datab 'Program                 Date       Time   Notes',13,10
datab '-------------------------------------------------------------------------------',13,10
logline:
datab '                  ??/??/??  ??:??',13,10